module double_precision_array_generator_m
    use double_precision_array_input_m, only: double_precision_array_input_t
    use veggies, only: &
            generated_t, &
            generator_t, &
            input_t, &
            shrink_result_t, &
            get_random_double_precision_with_magnitude, &
            get_random_integer_with_range, &
            shrunk_value, &
            simplest_value


    implicit none
    private
    public :: double_precision_array_generator_t, DOUBLE_PRECISION_ARRAY_GENERATOR

    type, extends(generator_t) :: double_precision_array_generator_t
    contains
        private
        procedure, public :: generate
        procedure, public, nopass :: shrink
    end type

    type(double_precision_array_generator_t), parameter :: &
            DOUBLE_PRECISION_ARRAY_GENERATOR = double_precision_array_generator_t()
contains
    function generate(self) result(random_array)
        class(double_precision_array_generator_t), intent(in) :: self
        type(generated_t) :: random_array

        integer :: i

        associate(unused => self); end associate

        random_array = generated_t(double_precision_array_input_t( &
                [( get_random_double_precision_with_magnitude(1.0d6), &
                  i = 1, get_random_integer_with_range(0, 100))]))
    end function

    function shrink(input) result(shrunk)
        class(input_t), intent(in) :: input
        type(shrink_result_t) :: shrunk

        select type (input)
        type is (double_precision_array_input_t)
            associate(the_array => input%input())
                associate(n => size(the_array))
                    select case (n)
                    case (0)
                        shrunk = simplest_value(double_precision_array_input_t( &
                                [double precision ::]))
                    case (1)
                        if (effectively_zero(the_array(1))) then
                            shrunk = simplest_value(double_precision_array_input_t( &
                                    [double precision ::]))
                        else
                            shrunk = shrunk_value(double_precision_array_input_t( &
                                    [the_array(1)/2.0d0]))
                        end if
                    case default
                        shrunk = shrunk_value(double_precision_array_input_t( &
                                the_array(1:n/2)))
                    end select
                end associate
            end associate
        end select
    end function

    pure function effectively_zero(value_)
        double precision, intent(in) :: value_
        logical :: effectively_zero

        effectively_zero = abs(value_) < epsilon(value_)
    end function
end module
